home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d7 / exechk.arc / ABORT.INC next >
Text File  |  1990-12-06  |  2KB  |  38 lines
  1. (*******************************************************************
  2. Procedure to abort process in case of error; with message.
  3. *******************************************************************)
  4. procedure Abort ( S : string ) ;
  5. begin
  6.    writeln ( 'Message : ' , S , #7#7#7 ) ;
  7.    Halt ( 1 ) ;
  8. end ;
  9. (*******************************************************************
  10. Convert string to upper case.
  11. *******************************************************************)
  12. function Upper ( S : string ) : string ;
  13. var
  14.    temp                      : string ;
  15.    B                         : byte ;
  16. begin
  17.    temp                      := S ;
  18.    for B := 1 to length ( S ) do
  19.       temp [ B ]             := UpCase ( temp [ B ] ) ;
  20.    Upper                     := temp ;
  21. end ;
  22. (*******************************************************************
  23. Returns a byte for the drive letter, where 1 thru 26 = A: thru Z:
  24. *******************************************************************)
  25. function DriveNum ( S : string ) : byte ;
  26. begin
  27.    DriveNum                  := 0 ;
  28.    if pos ( ':' , S ) <> 2 then EXIT ;
  29.    DriveNum                  := ord ( UpCase ( S [ 1 ] ) ) - 64 ;
  30. end ;
  31. (*******************************************************************
  32. Check that this program is an EXE file AND is on drive A:
  33. *******************************************************************)
  34. function IsDriveA ( S : string ) : boolean ;
  35. begin
  36.    IsDriveA                  := DriveNum ( S ) = 1 ;
  37. end ;
  38.